﻿Imports System.Runtime.InteropServices
'Imports System.NetImports
Imports System.Net.Sockets
Imports System.Text.RegularExpressions
'Imports System.XmlImports
Imports System.Text
'Imports System.IOPublic
'Imports System.Net.Sockets
Imports System.Net


Class epp
    Public _exit As Boolean = True
    Public _pws As String
    Public _regeditmesage As String
    Public _purveyor As String
    Public obj As Form1
    Public Event epp_event(ByVal domain As String)
    <DllImport("libeay32.dll", EntryPoint:="BIO_new_socket", SetLastError:=True)> _
    Public Shared Function BIO_new_socket(ByVal socket As IntPtr, ByVal flag As Integer) As IntPtr
    End Function
    <DllImport("libeay32.dll", EntryPoint:="OPENSSL_add_all_algorithms_noconf", SetLastError:=True)> _
    Public Shared Sub OPENSSL_add_all_algorithms_noconf()
    End Sub
    <DllImport("ssleay32.dll", EntryPoint:="SSL_connect", SetLastError:=True)> _
    Public Shared Function SSL_connect(ByVal sslSocket As IntPtr) As Integer
    End Function
    <DllImport("ssleay32.dll", EntryPoint:="SSL_CTX_new", SetLastError:=True)> _
    Public Shared Function SSL_CTX_new(ByVal ptr As IntPtr) As IntPtr
    End Function
    <DllImport("ssleay32.dll", EntryPoint:="SSL_CTX_free", SetLastError:=True)> _
    Public Shared Sub SSL_CTX_free(ByVal ssl As IntPtr)
    End Sub
    <DllImport("ssleay32.dll", EntryPoint:="SSL_get_error", SetLastError:=True)> _
    Public Shared Function SSL_get_error(ByVal ssl As IntPtr, ByVal ret As Integer) As Integer
    End Function
    <DllImport("ssleay32.dll", EntryPoint:="SSL_library_init", SetLastError:=True)> _
    Public Shared Function SSL_library_init() As Integer
    End Function
    <DllImport("ssleay32.dll", EntryPoint:="SSL_new", SetLastError:=True)> _
    Public Shared Function SSL_new(ByVal ptr As IntPtr) As IntPtr
    End Function
    <DllImport("ssleay32.dll", EntryPoint:="SSL_read", SetLastError:=True)> _
    Public Shared Function SSL_read(ByVal ssl As IntPtr, ByVal buf() As Byte, ByVal num As Integer) As Integer
    End Function
    <DllImport("ssleay32.dll", EntryPoint:="SSL_set_fd", SetLastError:=True)> _
    Public Shared Sub SSL_set_fd(ByVal ssl As IntPtr, ByVal sd As IntPtr)
    End Sub
    <DllImport("ssleay32.dll", EntryPoint:="SSL_set_bio", SetLastError:=True)> _
    Public Shared Sub SSL_set_bio(ByVal ssl As IntPtr, ByVal BioRbio As IntPtr, ByVal BioWbio As IntPtr)
    End Sub
    <DllImport("ssleay32.dll", EntryPoint:="SSL_shutdown", SetLastError:=True)> _
    Public Shared Function SSL_shutdown(ByVal ssl As IntPtr) As Integer
    End Function
    <DllImport("ssleay32.dll", EntryPoint:="SSL_write", SetLastError:=True)> _
    Public Shared Function SSL_write(ByVal ssl As IntPtr, ByVal buf() As Byte, ByVal num As Integer) As Integer
    End Function
    <DllImport("ssleay32.dll", EntryPoint:="SSLv23_client_method", SetLastError:=True)> _
    Public Shared Function SSLv23_client_method() As IntPtr
    End Function
    <DllImport("ssleay32.dll", EntryPoint:="SSL_CTX_use_certificate_file", SetLastError:=True)> _
    Public Shared Function SSL_CTX_use_certificate_file(ByVal ssl As IntPtr, ByVal file As String, ByVal n As Integer) As IntPtr
    End Function
    <DllImport("ssleay32.dll", EntryPoint:="SSL_CTX_use_PrivateKey_file", SetLastError:=True)> _
    Public Shared Function SSL_CTX_use_PrivateKey_file(ByVal ssl As IntPtr, ByVal file As String, ByVal n As Integer) As IntPtr
    End Function
    <DllImport("ssleay32.dll", EntryPoint:="SSL_CTX_check_private_key", SetLastError:=True)> _
    Public Shared Function SSL_CTX_check_private_key(ByVal ssl As IntPtr) As IntPtr
    End Function
    Const SSL_FILETYPE_PEM = 1
    Dim bReceived(4098) As Byte
    Dim numBytes As Integer
    Dim mySocket As New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
    Dim epHost_cn As New IPEndPoint(Dns.GetHostByName("218.241.97.22").AddressList(0), 3000) ' random SSL-enforcing server for testing purposes     Dim epHost_en As New IPEndPoint(Dns.GetHostByName("218.241.97.2").AddressList(0), 3121) ' random SSL-enforcing server for testing purposes     Dim sslCtx As IntPtr    Dim ssl_socket As IntPtr    Private Function GeneralCode() As String        'general   random   value   from   65(A)   to   122(z)           Dim pre1 As Byte        Dim pre2 As Byte        Dim value As Integer        Dim value1 As Integer        Randomize()   '   Initialize   random-number   generator.           'A--Z           pre1 = Int((122 - 97 + 1) * Rnd() + 97)        pre2 = Int((122 - 97 + 1) * Rnd() + 97)        value = Int((1000000 * Rnd()) + 1)        value1 = Int((1000000 * Rnd()) + 1)        Dim code As String        code = Char.ToUpper(Convert.ToChar(pre1)) & Char.ToUpper(Convert.ToChar(pre2)) & value.ToString & value1.ToString        Return code    End Function    Public Function login(ByVal certificate As String, ByVal PrivateKey As String, ByVal user As String, ByVal pws As String, ByVal iscn As Boolean)        Try            mySocket.Blocking = True            Dim _bre As String            If iscn Then                mySocket.Connect(epHost_en)            Else                mySocket.Connect(epHost_cn)            End If            If mySocket.Connected Then                SSL_library_init()                sslCtx = SSL_CTX_new(SSLv23_client_method())                If (SSL_CTX_use_certificate_file(sslCtx, certificate, SSL_FILETYPE_PEM)) Then                    If SSL_CTX_use_PrivateKey_file(sslCtx, PrivateKey, SSL_FILETYPE_PEM) Then                        If SSL_CTX_check_private_key(sslCtx) Then                        Else                            Return -1 ''证书出错                        End If                    Else                        '''''''''''''''证书出错''''''                        Return -1                    End If                Else                    ''''''''''''''''''''''''''                    Dim errcode As Integer = SSL_get_error(ssl_socket, numBytes)                    Return errcode '证书出错                End If                ssl_socket = SSL_new(sslCtx)                SSL_set_fd(ssl_socket, mySocket.Handle)                Dim connOK As Integer = SSL_connect(ssl_socket)                If connOK = 1 Then                    mySocket.Blocking = True                    If iscn Then                        ' Do                        numBytes = SSL_read(ssl_socket, bReceived, bReceived.Length)                        '     ListBox1.Items.Add(System.Text.Encoding.ASCII.GetString(bReceived, 0, numBytes))                        'Loop While numBytes > 174                    Else                        'Do                        numBytes = SSL_read(ssl_socket, bReceived, bReceived.Length)                        '     ListBox1.Items.Add(System.Text.Encoding.ASCII.GetString(bReceived, 0, numBytes))                        'Loop While numBytes > 64                    End If                    Dim bRequest() As Byte                    Dim encText As New System.Text.UTF8Encoding()                    bRequest = encText.GetBytes(loginstring(user, pws, GeneralCode, iscn))                    Dim numWritten As Integer = SSL_write(ssl_socket, bRequest, bRequest.Length)                    'Dim errcode As Integer = SSL_get_error(ssl_socket, numBytes)                    Threading.Thread.Sleep(1000)                    'Do                    numBytes = SSL_read(ssl_socket, bReceived, bReceived.Length)                    '  ListBox1.Items.Add(regxre()                    _bre = System.Text.Encoding.ASCII.GetString(bReceived, 0, numBytes)                    Return (regnum(regxre(_bre)))                    'Loop While numBytes > 64                End If                Return -2            Else                Return -3            End If        Catch ex As Exception            Return -4        End Try    End Function    Public Function loginstring(ByVal user As String, ByVal pws As String, ByVal clTRID As String, ByVal isen As Boolean) As String        Dim longin As String        If isen Then            longin = "<?xml version=" + Chr(34) + "1.0" + Chr(34) + " encoding=" + Chr(34) + "UTF-8" + Chr(34) + " standalone=" + Chr(34) + "no" + Chr(34) + "?>" + _            "<epp xmlns=" + Chr(34) + "urn:iana:xml:ns:epp-1.0" + Chr(34) + " xmlns:xsi=" + Chr(34) + "http://www.w3.org/2001/XMLSchema-instance" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:epp-1.0 epp-1.0.xsd" + Chr(34) + ">" + _             "<command>" + _              "<creds>" + _               "<clID>" + user + "</clID>" + _               "<pw>" + pws + "</pw>" + _               "<options>" + _                "<version>1.0</version>" + _                "<lang>en</lang>" + _               "</options>" + _              "</creds>" + _              "<login>" + _               "<svcs>" + _                "<contact:svc xmlns:contact=" + Chr(34) + "urn:iana:xml:ns:contact-1.0" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:contact-1.0 contact-1.0.xsd" + Chr(34) + "/>" + _                "<host:svc xmlns:host=" + Chr(34) + "urn:iana:xml:ns:host-1.0" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:host-1.0 host-1.0.xsd" + Chr(34) + "/>" + _                "<domain:svc xmlns:domain=" + Chr(34) + "urn:iana:xml:ns:domain-1.0" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:domain-1.0 domain-1.0.xsd" + Chr(34) + "/>" + _                "<unspec>" + _                 "<cnContact:svc xmlns:cnContact=" + Chr(34) + "urn:iana:xml:ns:cntld:contact-1.0" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:cntld:contact-1.0 cntld-contact-1.0.xsd" + Chr(34) + "/>" + _                 "<cnDomain:svc xmlns:cnDomain=" + Chr(34) + "urn:iana:xml:ns:cntld:domain-1.0" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:cntld:domain-1.0 cntld-domain-1.0.xsd" + Chr(34) + "/>" + _                 "<cnHost:svc xmlns:cnHost=" + Chr(34) + "urn:iana:xml:ns:cntld:host-1.0" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:cntld:host-1.0 cntld-host-1.0.xsd" + Chr(34) + "/>" + _                "</unspec>" + _               "</svcs>" + _              "</login>" + _              "<unspec/>" + _              "<clTRID>" + clTRID + "</clTRID>" + _             "</command>" + _            "</epp>"        Else            longin = "<?xml version=" + Chr(34) + "1.0" + Chr(34) + " encoding=" + Chr(34) + "UTF-8" + Chr(34) + " standalone=" + Chr(34) + "no" + Chr(34) + "?> <epp xmlns=" + Chr(34) + "urn:iana:xml:ns:epp-1.0" + Chr(34) + " xmlns:xsi=" + Chr(34) + "http://www.w3.org/2001/XMLSchema-instance" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:epp-1.0 epp-1.0.xsd" + Chr(34) + "> <command> <creds> <clID>" + user + "</clID><pw>" + pws + "</pw><options><version>1.0</version><lang>en-US</lang></options></creds><login><svcs><contact:svc xmlns:contact=" + Chr(34) + "urn:iana:xml:ns:contact-1.0" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:contact-1.0 contact-1.0.xsd" + Chr(34) + "/><domain:svc xmlns:domain=" + Chr(34) + "urn:iana:xml:ns:domain-1.0" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:domain-1.0 domain-1.0.xsd" + Chr(34) + "/><host:svc xmlns:host=" + Chr(34) + "urn:iana:xml:ns:host-1.0" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:host-1.0 host-1.0.xsd" + Chr(34) + "/><unspec><cn-domain:svc xmlns:cn-domain=" + Chr(34) + "urn:iana:xml:ns:cntld:cn-domain-1.0" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:cntld:cn-domain-1.0 cn-domain-1.0.xsd" + Chr(34) + "/><cn-registrant:svc xmlns:cn-registrant=" + Chr(34) + "urn:iana:xml:ns:cntld:cn-registrant-1.0" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:cntld:cn-registrant-1.0 cn-registrant-1.0.xsd" + Chr(34) + "/></unspec></svcs></login><clTRID>" + clTRID + "</clTRID></command></epp>"        End If        Return longin    End Function    Public Function createdomain(ByVal domain As String, ByVal isen As Boolean, ByVal clTRID As String, ByVal regmsg As String, ByVal pws As String, ByVal purveyor As String) As String        Dim _str As String        If isen = True Then            _str = "<?xml version=" + Chr(34) + "1.0" + Chr(34) + " encoding=" + Chr(34) + "UTF-8" + Chr(34) + " standalone=" + Chr(34) + "no" + Chr(34) + "?>" + _                "<epp xmlns=" + Chr(34) + "urn:iana:xml:ns:epp-1.0" + Chr(34) + " xmlns:xsi=" + Chr(34) + "http://www.w3.org/2001/XMLSchema-instance" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:epp-1.0 epp-1.0.xsd" + Chr(34) + ">" + _                "<command>" + _                "<create>" + _                    "<domain:create xmlns:domain=" + Chr(34) + "urn:iana:xml:ns:domain-1.0" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:domain-1.0 domain-1.0.xsd" + Chr(34) + ">" + _                     "<domain:name>" + domain + "</domain:name> " + _                    "<domain:period unit=" + Chr(34) + "y" + Chr(34) + ">1</domain:period>" + _                    "<domain:registrant>" + regmsg + "</domain:registrant>" + _                    "<domain:contact type=" + Chr(34) + "tech" + Chr(34) + ">" + regmsg + "</domain:contact>" + _                    "<domain:contact type=" + Chr(34) + "admin" + Chr(34) + ">" + regmsg + "</domain:contact>" + _                    "<domain:contact type=" + Chr(34) + "billing" + Chr(34) + ">" + regmsg + "</domain:contact>" + _                    "<domain:authInfo type=" + Chr(34) + "pw" + Chr(34) + ">" + pws + "</domain:authInfo>" + _                   "</domain:create>" + _                "</create>" + _                  "<unspec>" + _                   "<cnDomain:create xmlns:cnDomain=" + Chr(34) + "urn:iana:xml:ns:cntld:domain-1.0" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:cntld:domain-1.0 cntld-domain-1.0.xsd" + Chr(34) + ">" + _                    "<cnDomain:type>E</cnDomain:type>" + _                    "<cnDomain:purveyor>" + purveyor + "</cnDomain:purveyor>" + _                   "</cnDomain:create>" + _                  "</unspec>" + _                  "<clTRID>" + clTRID + clTRID + "</clTRID>" + _                 "</command>" + _                "</epp>"            ' 'Debug.Print(_str)        Else            _str = "<?xml version=" + Chr(34) + "1.0" + Chr(34) + " encoding=" + Chr(34) + "UTF-8" + Chr(34) + " standalone=" + Chr(34) + "no" + Chr(34) + "?> " + _            "<epp xmlns=" + Chr(34) + "urn:iana:xml:ns:epp-1.0" + Chr(34) + " xmlns:xsi=" + Chr(34) + "http://www.w3.org/2001/XMLSchema-instance" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:epp-1.0 epp-1.0.xsd" + Chr(34) + "> " + _            "<command>" + _                "<create>" + _                    "<domain:create xmlns=" + Chr(34) + "urn:iana:xml:ns:domain-1.0" + Chr(34) + " xmlns:domain=" + Chr(34) + "urn:iana:xml:ns:domain-1.0" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:domain-1.0 domain-1.0.xsd" + Chr(34) + ">" + _                    "<domain:name>" + domain + "</domain:name>" + _                    "<domain:period unit=" + Chr(34) + "y" + Chr(34) + ">1</domain:period> " + _                    "<domain:registrant>" + regmsg + "</domain:registrant> " + _                    "<domain:contact type=" + Chr(34) + "billing" + Chr(34) + ">" + regmsg + "</domain:contact>" + _                    "<domain:contact type=" + Chr(34) + "admin" + Chr(34) + ">" + regmsg + "</domain:contact> " + _                    "<domain:contact type=" + Chr(34) + "tech" + Chr(34) + ">" + regmsg + "</domain:contact>" + _                    "<domain:authInfo type=" + Chr(34) + "pw" + Chr(34) + ">" + pws + "</domain:authInfo> " + _                    "</domain:create>" + _                "</create>" + _                 "<unspec>" + _                     "<cn-domain:create xmlns:cn-domain=" + Chr(34) + "urn:iana:xml:ns:cntld:cn-domain-1.0" + Chr(34) + " xsi:schemaLocation=" + Chr(34) + "urn:iana:xml:ns:cntld:cn-domain-1.0 cn-domain-1.0.xsd" + Chr(34) + "> " + _                     "<cn-domain:purveyor>" + purveyor + "</cn-domain:purveyor>" + _                     "<cn-domain:cn-domain>" + _                     "<cn-domain:type>E</cn-domain:type>" + _                     "</cn-domain:cn-domain>" + _                     "</cn-domain:create>" + _                 "</unspec>" + _                 "<clTRID>" + clTRID + "</clTRID> " + _                 "</command>" + _                 "</epp>"        End If        Return _str    End Function    Public Function regedit_domain(ByVal domain As String, ByVal iscn As Boolean, ByVal _pws As String, ByVal _purveyor As String, ByVal _regeditmesage As String) As Integer        Dim bRequest() As Byte        Dim _bre As String        Dim encText As New System.Text.UTF8Encoding()        bRequest = encText.GetBytes(createdomain(domain, iscn, GeneralCode(), _regeditmesage, _pws, _purveyor))        Dim numWritten As Integer = SSL_write(ssl_socket, bRequest, bRequest.Length)        numBytes = SSL_read(ssl_socket, bReceived, bReceived.Length)        _bre = System.Text.Encoding.ASCII.GetString(bReceived, 0, numBytes)        Return (regnum(regxre(_bre)))    End Function    Private Function regxre(ByVal doc As String) As String        Dim _str As String = ""        Dim r As Regex        ''Debug.Print(doc)        r = New Regex("result code=.(....).")        '在TextBox1.Text中检索一个和正则表达式一致的对象        Dim m As Match        m = r.Match(doc)        '如下，也可以检索所有的一致的对象        'Dim m As MatchCollection = r.Matches(TextBox1.Text)        While m.Success            '发现一致的对象的时候            '表示发现部分的文字列            _str += m.Value            '检索下一个一致的对象            m = m.NextMatch()        End While        Return _str    End Function    Private Function regnum(ByVal doc As String) As Integer        Dim _str As String = ""        Dim r As Regex        r = New Regex("(/d+)")        '在TextBox1.Text中检索一个和正则表达式一致的对象        If doc.Trim() = "" Then Return 0        Dim m As Match        m = r.Match(doc)        '如下，也可以检索所有的一致的对象        'Dim m As MatchCollection = r.Matches(TextBox1.Text)        While m.Success            '发现一致的对象的时候            '表示发现部分的文字列            _str += m.Value            '检索下一个一致的对象            m = m.NextMatch()        End While        Return Integer.Parse(_str)    End Function    Public Function cp_timer(ByVal s1 As String, ByVal s2 As String) As Boolean        Dim a() As String = s1.Split(":")        Dim b() As String = s2.Split(":")        If a.Length <> 3 Then Return False : Exit Function        If b.Length <> 3 Then Return False : Exit Function        If (Integer.Parse(a(0)) > Integer.Parse(b(0))) Then            Return True            Exit Function        Else            If (Integer.Parse(a(0)) = Integer.Parse(b(0))) Then                If (Integer.Parse(a(1)) > Integer.Parse(b(1))) Then                    Return True                Else                    If (Integer.Parse(a(1)) = Integer.Parse(b(1))) Then                        If (Integer.Parse(a(2)) > Integer.Parse(b(2))) Then                            Return True                        Else                            Return False                        End If                    End If                End If                Return False            End If        End If    End Function    Public Sub autoregedit(ByVal iscn As Boolean, ByVal end_time As String)        Dim i As Integer = 0        Dim _re As Integer        Dim _string As String        ' 'Debug.Print("开始注册" & Now.ToLongTimeString())        _string = getdomain(_re, obj)        While (_exit)            _re = regedit_domain(_string, iscn, _pws, _purveyor, _regeditmesage)            _string = getdomain(_re, obj)            If cp_timer(Now.ToLongTimeString(), end_time) Then Exit While        End While        '  'Debug.Print("结束注册" + end_time)    End Sub    Public Sub autoregedit(ByVal Domain As ArrayList, ByVal iscn As Boolean, ByVal end_time As String)        Dim i As Integer = 0        Dim _re As Integer        Dim _string As String        ' 'Debug.Print("开始注册" & Now.ToLongTimeString())        While (_exit)            If Domain.Count = 0 Then Exit While            Try                _string = Domain.Item(i)                _re = regedit_domain(_string, iscn, _pws, _purveyor, _regeditmesage)                If _re = 1000 Then                    obj.setlistbox1(_string & "注册成功 ")                    Domain.RemoveAt(i)                End If                If i >= Domain.Count - 1 Then                    i = 0                Else                    i = i + 1                End If            Catch ex As Exception                ' 'Debug.Print(ex.Message)            End Try            If cp_timer(Now.ToLongTimeString(), end_time) Then Exit While        End While        '  'Debug.Print("结束注册" + end_time)    End Sub    Public Sub autoregedit(ByVal Domain As ArrayList, ByVal iscn As Boolean, ByVal t As Boolean)        Dim i As Integer = 0        Dim _re As Integer        Dim _string As String        While (i <= Domain.Count)            If Domain.Count = 0 Then Exit Sub            Try                _string = Domain.Item(i)                _re = regedit_domain(_string, iscn, _pws, _purveyor, _regeditmesage)                If _re = 1000 Then                    obj.setlistbox1(_string & "注册成功 ")                    ' Domain.RemoveAt(i)                Else                End If                i = i + 1            Catch ex As Exception                'Debug.Print(ex.Message)            End Try            'If Now.ToLongTimeString() = "4:10:00" Then Exit While        End While    End Sub    Public Sub autoregedit(ByVal Domain As ArrayList, ByVal iscn As Boolean)        Dim i As Integer = 0        Dim _re As Integer        Dim _string As String        _string = Domain.Item(0)        _re = regedit_domain(_string, iscn, _pws, _purveyor, _regeditmesage)        If _re = 1000 Then obj.setlistbox1(_string & "注册成功 ")    End SubEnd Class
End Class
